﻿Module modGeneral
    ' Paramètres de l'application
    Public ctDSN_AEM As String

    Public myConnect As New Odbc.OdbcConnection    'Objet qui définit la connexion ODBC
    Public myCommand As New Odbc.OdbcCommand       'Objet Command qui contient une requête SQL

    Public gUserCode As String                  ' code utilisateur connecté
    Public gUserNom As String                   ' nom utilisateur connecté
    Public gUserAcces As String                 ' role utilisateur connecté
    Public gUserAgence As String                ' agence utilisateur connecté
    Public gNomAgence As String                 ' nom agence utilisateur connecté
    Public gCD_CLI As Integer = 0               ' Elève encours de traitement
    Public gDate_debut As Date = Now()         ' Date début de traitement
    Public gDate_fin As Date = Now()           ' Date fin de traitement
    Public gMoniteur1 As String
    Public gMoniteur2 As String
    Public gNumero As Integer
    Public gTypePlanning As String
    Public gSemaine As Integer
    Public gGroupe As String
    Public gRelance As String

    Private szSQL As String
    Private rs As ADODB.Recordset = Nothing
    '-------------------------------------------------------------------------------------
    Public Function nv(ByVal c As Object) As Object
        ' remplace une chaine NULL en ""
        On Error Resume Next
        nv = vbNullString & c

    End Function

    Public Function nq(ByVal c As String) As String
        ' remplace les quotes par ''
        On Error Resume Next
        nq = Replace(c, "'", "\'")

    End Function

    Public Function ns(ByVal c As String) As String
        ' remplace les slash par \\
        On Error Resume Next
        ns = Replace(c, "\", "\\")

    End Function

    Public Function nz(ByVal c As Object) As Double
        If TypeOf c Is System.DBNull Then
            Return 0
        Else
            Return c
        End If
    End Function

    Public Function Zero2Space(ByVal montant As Decimal) As String
        ' renvoie espace si montant = zero
        If montant Then
            Zero2Space = montant.ToString
        Else
            Zero2Space = ""
        End If

    End Function

    Public Function IfDate(ByVal dDate As Object) As String
        ' renvoie espace si non date
        If IsDate(dDate) Then
            IfDate = Format(dDate, "dd/MM/yyyy")
        Else
            IfDate = ""
        End If

    End Function

    Public Function IfDatetime(ByVal dDate As Object) As String
        ' renvoie espace si non date
        If IsDate(dDate) Then
            IfDatetime = Format(dDate, "dd/MM/yyyy hh:mm")
        Else
            IfDatetime = ""
        End If

    End Function

    ' Obtient le libellé dans une table par son code
    Public Function getLibelleByCode(ByVal NomTable As String, ByVal Code As Integer) As String

        ' Lire la table NomTable
        szSQL = "CALL spGet_P_TABLES_byCODE('" & NomTable & "'," & Code & ")"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount > 0 Then
            If NomTable = "P_MODE_REGL" Then
                getLibelleByCode = rs.Fields("lib4").Value
            Else
                getLibelleByCode = rs.Fields("libelle").Value
            End If
        Else
            getLibelleByCode = ""
        End If
        rs.Close()
        rs = Nothing

    End Function

    ' Obtient le délai d'annulation de RDV
    Public Function getDelaiAnnulation(ByVal Code As Integer) As Integer

        ' Lire la table AGENCES
        szSQL = "CALL spGet_P_TABLES_byCODE('P_AGENCES'," & Code & ")"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount > 0 Then
            getDelaiAnnulation = rs.Fields("delai_annul").Value
        Else
            getDelaiAnnulation = 0
        End If
        rs.Close()
        rs = Nothing

    End Function

    ' Obtient le code dans une table par son libellé
    Public Function getCodeByLibelle(ByVal NomTable As String, ByVal Libelle As String) As Integer

        ' Lire la table NomTable
        szSQL = "SELECT code from " & NomTable & " WHERE libelle = " & Libelle
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount > 0 Then
            getCodeByLibelle = rs.Fields("code").Value
        Else
            getCodeByLibelle = 0
        End If
        rs.Close()
        rs = Nothing

    End Function

    Public Function getAdresse(ByVal pLieu As String) As String

        szSQL = "SELECT adresse from P_LIEUX WHERE type = 'EX' AND lieu = '" & pLieu & "'"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount > 0 Then
            getAdresse = rs.Fields("adresse").Value
        Else
            getAdresse = "Non trouvé"
        End If
        rs.Close()

    End Function

    ' Obtient le 1er prenom 
    Public Function get1erPrenom(ByVal Parametres As String) As String
        Dim ix As Integer

        ' recherche le 1er espace
        ix = InStr(Parametres, " ")
        If ix > 0 Then
            get1erPrenom = Mid(Parametres, 1, ix - 1)
        Else
            get1erPrenom = Parametres
        End If

    End Function

    ' Obtient le code par son libellé dans une combo 
    Public Function getCodeFromCombo(ByVal Libelle As String) As String
        Dim ix As Integer

        ' recherche le séparateur
        ix = InStr(Libelle, "|")
        If ix > 0 Then
            getCodeFromCombo = Trim(Mid(Libelle, 1, ix - 1))
        Else
            getCodeFromCombo = ""
        End If

    End Function

    Public Function deleteEnregistrement(ByVal NomTable As String, ByVal Libelle As String, ByVal Cle As String, _
                     Optional ByVal cle2 As String = "", Optional ByVal cle3 As String = "", Optional ByVal cle4 As String = "", Optional ByVal cle5 As String = "") As Boolean

        deleteEnregistrement = False
        ' suppression d'un enregistrement
        If MessageBox.Show("Etes-vous sûr de vouloir supprimer " & Libelle & " ?", "Confirmation de la suppression", _
                            MessageBoxButtons.OKCancel, MessageBoxIcon.Question) = Windows.Forms.DialogResult.OK Then
            If Cle.Length = 0 Then
                MsgBox("Veuillez sélectionner d'abord un élément.")
                Exit Function
            End If

            szSQL = "CALL spDel_" & NomTable & " ('" & Cle
            If cle2 <> "" Then
                szSQL = szSQL & "','" & cle2
            End If
            If cle3 <> "" Then
                szSQL = szSQL & "','" & cle3
            End If
            If cle4 <> "" Then
                szSQL = szSQL & "','" & cle4
            End If
            If cle5 <> "" Then
                szSQL = szSQL & "','" & cle5
            End If
            szSQL = szSQL & "')"
            If ExecQuery(ctDSN_AEM, szSQL) Then
                deleteEnregistrement = True
            End If
        End If

    End Function

    Public Sub InitComboAgences(ByVal combo As ComboBox)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table AGENCES
        szSQL = "CALL spGet_P_TABLES_byCODE('P_AGENCES',0)"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("libelle").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        combo.SelectedIndex = gUserAgence - 1

    End Sub

    Public Sub InitComboFilieres(ByVal combo As ComboBox)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table AGENCES
        szSQL = "CALL spGet_P_TABLES_byCODE('P_FILIERES',0)"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("code").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        combo.SelectedIndex = 0

    End Sub

    Public Sub InitComboPermis(ByVal combo As ComboBox)

        ' vider le combo Permis
        combo.Items.Clear()
        ' Lire la table PERMIS
        szSQL = "CALL spGet_PERMIS('')"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("cat").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        combo.SelectedIndex = 3

    End Sub

    Public Sub InitComboPays(ByVal combo As ComboBox)

        ' vider le combobox PAYS
        combo.Items.Clear()
        szSQL = "CALL spGet_P_TABLES_byCODE('P_PAYS',0)"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        ' Load the data.
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("code").Value & " - " & rs.Fields("libelle").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        If combo.Items.Count Then
            combo.SelectedIndex = 0
        End If

    End Sub

    Public Sub InitComboSocietes(ByVal combo As ComboBox)

        ' vider le combobox SOCIETES
        combo.Items.Clear()
        szSQL = "CALL spGet_SOCIETES('')"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        ' Load the data.
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("code").Value & " | " & rs.Fields("nom").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        If combo.Items.Count Then
            combo.SelectedIndex = 0
        End If

    End Sub

    Public Sub InitComboStatutsExam(ByVal combo As ComboBox)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table STATUTS EXAMEN
        szSQL = "CALL spGet_P_TABLES_byCODE('P_STATUTS_EXAM',0)"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("code").Value & " | " & rs.Fields("libelle").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        If combo.Items.Count Then
            combo.SelectedIndex = 0
        End If

    End Sub

    Public Sub InitComboStatutsLecon(ByVal combo As ComboBox)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table STATUTS EXAMEN
        szSQL = "CALL spGet_P_TABLES_byCODE('P_STATUTS_LECON',0)"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("code").Value & " | " & rs.Fields("libelle").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        If combo.Items.Count Then
            combo.SelectedIndex = 0
        End If

    End Sub

    Public Sub InitComboLieux(ByVal combo As ComboBox, ByVal type As String)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table P_LIEUX
        szSQL = "SELECT lieu from P_LIEUX WHERE type = '" & type & "' ORDER BY lieu"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("lieu").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()
        If combo.Items.Count Then
            combo.SelectedIndex = 0
        End If

    End Sub

    Public Sub InitComboMoniteur(ByVal combo As ComboBox)

        ' vider le combobox
        combo.Items.Clear()
        ' Lire la table MONITEURS
        szSQL = "CALL spGet_MONITEURS('')"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("cd_mon").Value & " | " & rs.Fields("nom").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()

    End Sub

    Public Sub InitComboTarifs(ByVal combo As ComboBox)

        ' vider le combo 
        combo.Items.Clear()
        ' Lire la table TARIFS
        szSQL = "CALL spGet_TARIFS('')"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        Do While Not rs.EOF
            combo.Items.Add(rs.Fields("ref").Value & " | " & rs.Fields("lib").Value)
            rs.MoveNext()
        Loop
        ' Close the recordset AND connection.
        rs.Close()

    End Sub

    Public Sub setIndice(ByVal i As Integer, ByVal liste As ListView)
        ' borner l'indice par le nb d'éléments de la liste
        If i >= liste.Items.Count Then
            i = liste.Items.Count - 1
        End If
        ' puis sélectionner la ligne i
        If liste.Items.Count > 0 Then
            liste.Select()
            liste.Items(i).Selected = True
            liste.Items(i).EnsureVisible()
        End If
    End Sub

    Public Function IsUserAuthorised(ByVal code As Integer) As Boolean
        ' utilisateur autorisé à effectuer ?
        If gUserAcces < code Then
            MsgBox("Désolé, vous n'êtes pas autorisé(e) à effectuer cette opération !", MsgBoxStyle.Exclamation, "AGENDA")
            IsUserAuthorised = False
        Else
            IsUserAuthorised = True
        End If

    End Function

    Public Function IsDelaiOK(ByVal Jour As Date) As Boolean
        Dim delai As Integer = getDelaiAnnulation(gUserAgence)

        IsDelaiOK = False
        ' si Vendredi ou Samedi, ajouter un jour supplémentaire
        If Now.DayOfWeek = vbFriday Or Now.DayOfWeek = vbSaturday Then
            delai += 1
        End If
        ' délai annulation ?
        If DateDiff(DateInterval.Day, Now, Jour) < delai Then
            MsgBox("Une Leçon ne peut être annulée moins de " & delai * 24 & "heures à l'avance!", MsgBoxStyle.Critical)
            Exit Function
        End If
        IsDelaiOK = True

    End Function

    Public Function IsExported(ByVal Jour As Date) As Boolean
        IsExported = False
        ' La journée est-elle déjà exportée en compta ?
        If DateDiff(DateInterval.Day, Jour, getDateDerniere("export", 6)) >= 0 Then
            MsgBox("Cette journée est déjà comptabilisée ! Modification impossible.", MsgBoxStyle.Critical)
            IsExported = True
        End If
    End Function

    Public Function IsValidated(ByVal Jour As Date) As Boolean
        ' La journée est-elle déjà validée ?
        If DateDiff(DateInterval.Day, Jour, getDateDerniere("validation", gUserAgence)) >= 0 Then
            ' MsgBox("Cette journée est déjà validée ! Modification impossible.", MsgBoxStyle.Critical)
            IsValidated = True
        Else
            IsValidated = False
        End If
    End Function

    ' Controles sur le dossier Eleve lors 
    ' - d'un débit (DEB)
    ' - d'un examen (EXA) ou d'une convocation exam (EXC)
    ' - d'une mise en planning B (PLB)
    ' - d'une évaluation (EVA)
    Public Function ControlerEleves(ByVal Type As String, ByVal cd_cli As Integer, Optional ByVal Planning As String = "") As Boolean
        Dim rs2 As ADODB.Recordset = Nothing
        Dim Solde As Decimal
        Dim TotalEncours As Integer

        ControlerEleves = False

        ' si eleve provisoire, ne pas effectuer les controles 
        If IsEleve(cd_cli) = False Then
            ControlerEleves = True
            Exit Function
        End If

        ' Lire la fiche Elève
        szSQL = "CALL spGet_ELEVES_byCD_CLI(" & cd_cli & ")"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount < 1 Then
            MsgBox("Elève " & cd_cli & " non trouvé !", MsgBoxStyle.Critical)
            rs.Close()
            Exit Function
        End If
        ' est-ce une activité ? oui, fin des controles
        If rs.Fields("agence").Value = 0 Then
            ControlerEleves = True
            Exit Function
        End If

        ' lire le permis demandé pour connaitre l'encours autorisé
        szSQL = "CALL spGet_PERMIS('" & rs.Fields("permis_demande").Value & "')"
        GetRecordset(ctDSN_AEM, szSQL, rs2)
        If rs2.RecordCount < 1 Then
            MsgBox("Permis " & rs.Fields("permis_demande").Value & " non trouvée !", MsgBoxStyle.Critical)
            rs2.Close()
            rs.Close()
            Exit Function
        End If
        ' total encours = encours permis et encours societe
        TotalEncours = rs2.Fields("encours").Value + rs.Fields("encours_societe").Value
        ' controler encours dépassé ?
        If TotalEncours > 0 Then
            If Mid(Type, 1, 2) = "EX" Then
                ' encours prévisionnel dépassé ?
                Solde = rs.Fields("credit").Value - rs.Fields("debit").Value
                If (Solde < -5) Then
                    MsgBox("Le solde prévisionnel de l'élève est égal à " & Solde & "," & vbCrLf & _
                           "il a dépassé l'encours autorisé (-5 €).", MsgBoxStyle.Critical)
                    If Type = "EXC" And gUserAcces < 9 Then
                        rs2.Close()
                        rs.Close()
                        Exit Function
                    End If
                End If
            Else
                If Type <> "EVA" Then
                    ' encours réel dépassé ?
                    Solde = rs.Fields("credit").Value - rs.Fields("mtval").Value
                    If Solde + TotalEncours < 0 Then
                        MsgBox("Le solde réel de l'élève est égal à " & Solde & "," & vbCrLf & _
                               "il a dépassé l'encours autorisé (" & TotalEncours & ").", MsgBoxStyle.Critical)
                        rs2.Close()
                        rs.Close()
                        Exit Function
                    End If
                    ' encours prévisionnel dépassé ?
                    'Solde = rs.Fields("credit").Value - rs.Fields("debit").Value
                    'If (Solde < -119) Then
                    '    MsgBox("Le solde prévisionnel de l'élève est égal à " & Solde & "," & vbCrLf & _
                    '           "il a dépassé l'encours autorisé (-119 €).", MsgBoxStyle.Critical)
                    '    rs2.Close()
                    '    rs.Close()
                    '    Exit Function
                    'End If
                End If
            End If
        End If
        rs2.Close()

        If IsDate(rs.Fields("cloture_le").Value) Then
            MsgBox("Le DOSSIER de cet élève est CLOTURE ou RETIRE ou en LITIGE !", MsgBoxStyle.Critical)
            rs.Close()
            Exit Function
        End If

        If rs.Fields("elevegarde02").Value Then
            MsgBox("Le DOSSIER est gardé par l'élève !", MsgBoxStyle.Critical)
            rs.Close()
            Exit Function
        End If

        If IsDate(rs.Fields("complet_le").Value) = False Or IsDate(rs.Fields("dossier_date").Value) = False Then
            MsgBox("Attention! Le dossier de l'élève est INCOMPLET ou NON ENREGISTRE.", MsgBoxStyle.Information)
            If Type = "EXA" Then
                rs.Close()
                Exit Function
            End If
        End If

        Dim nbJours As Integer
        ' controler la date de validité du dossier
        If IsDate(rs.Fields("dossier_valide").Value) = True Then
            nbJours = DateDiff(DateInterval.Day, Now, rs.Fields("dossier_valide").Value)
            If nbJours < 0 Then
                MsgBox("Attention! Le dossier de l'élève est expriré.", MsgBoxStyle.Critical)
                Exit Function
            Else
                If nbJours < 90 Then
                    MsgBox("Attention! Le dossier de l'élève expirera dans " & nbJours & " jours.", MsgBoxStyle.Information)
                End If
            End If
        End If

        ' controler la date de validité de la visite medicale
        If IsDate(rs.Fields("visite_med_fin_le").Value) = True Then
            nbJours = DateDiff(DateInterval.Day, Now, rs.Fields("visite_med_fin_le").Value)
            If nbJours < 0 Then
                MsgBox("Attention! La date de visite médicale de l'élève est exprirée.", MsgBoxStyle.Critical)
                Exit Function
            Else
                If nbJours < 90 Then
                    MsgBox("Attention! La date de visite médicale de l'élève expirera dans " & nbJours & " jours.", MsgBoxStyle.Information)
                End If
            End If
        End If

        ' controles spécifiques
        Dim PermisCompatible As Boolean = False
        Select Case Type
            Case "PLB", "EVA"
                If rs.Fields("permis_demande").Value = "B" Then
                    PermisCompatible = True
                End If
            Case "PLM"
                ' controle de la cat de l'eleve p/r au planning
                Select Case Planning
                    Case "A"    ' moto
                        If rs.Fields("permis_demande").Value = "A" Or rs.Fields("permis_demande").Value = "AL" Then
                            PermisCompatible = True
                        End If
                    Case "I", "R", "E"    ' circuit
                        If rs.Fields("permis_demande").Value = "B" Then
                            PermisCompatible = True
                        End If
                    Case Else
                        PermisCompatible = True
                End Select

            Case "PLS"
                ' controle de la cat de l'eleve p/r au planning
                Select Case Planning
                    Case "M"
                        If rs.Fields("permis_demande").Value = "A" Or rs.Fields("permis_demande").Value = "AL" Then
                            PermisCompatible = True
                        End If
                    Case "B"
                        If rs.Fields("permis_demande").Value = "B" Then
                            PermisCompatible = True
                        End If
                        If gUserAcces <= 2 Then
                            MsgBox("Les moniteurs sont autorisés à modifier seulement le planning Moto !", MsgBoxStyle.Critical)
                            rs.Close()
                            Exit Function
                        End If
                    Case Else
                        If rs.Fields("permis_demande").Value = "POINT" Then
                            PermisCompatible = True
                        End If
                End Select

            Case "EXA"
                If rs.Fields("credit").Value < 20 And rs.Fields("type_entreprise").Value = "P" Then
                    MsgBox("L'élève n'a fait aucun réglement. Inscription à l'examen impossible", MsgBoxStyle.Critical)
                    rs.Close()
                    Exit Function
                End If
                ' lire la formule pour date de validité
                szSQL = "CALL spGet_FORMULES('" & rs.Fields("formule").Value & "')"
                GetRecordset(ctDSN_AEM, szSQL, rs2)
                If rs2.RecordCount < 1 Then
                    MsgBox("Formule " & rs.Fields("formule").Value & " non trouvée !", MsgBoxStyle.Critical)
                    rs2.Close()
                    rs.Close()
                    Exit Function
                End If
                If rs2.Fields("duree").Value And (rs.Fields("fin_contrat_le").Value < Today) Then
                    MsgBox("La VALIDITE du forfait de cet élève est DEPASEE. !" & vbCrLf & _
                           "Cette prestation lui sera débitée lors de la validation", MsgBoxStyle.Information)
                End If
                rs2.Close()
                PermisCompatible = True
            Case Else
                PermisCompatible = True
        End Select
        If PermisCompatible = False Then
            MsgBox("La catégorie de permis demandée n'est pas compatible avec ce planning !", MsgBoxStyle.Critical)
            rs.Close()
            Exit Function
        End If

        rs.Close()
        ControlerEleves = True

    End Function

    ' Controles lors de l'examen
    Public Function ControlesExamen(ByVal Type As String, ByVal cd_cli As Integer, ByVal no_exa As Integer, ByVal date_exa As Date, ByVal agence As Integer) As Boolean

        Dim rsEXAM As ADODB.Recordset = Nothing
        Dim rsPermis As ADODB.Recordset = Nothing
        Dim rs2 As ADODB.Recordset = Nothing
        Dim heure_conduite As String

        ControlesExamen = False

        ' si eleve provisoire, ne pas effectuer les controles 
        If IsEleve(cd_cli) = False Then
            ControlesExamen = True
            Exit Function
        End If

        ' Lire la fiche Elève
        szSQL = "CALL spGet_ELEVES_byCD_CLI(" & cd_cli & ")"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount < 1 Then
            MsgBox("Elève " & cd_cli & " non trouvé !", MsgBoxStyle.Critical)
            rs.Close()
            Exit Function
        End If

        ' lire la formule pour la ref d'heure de conduite
        szSQL = "spGet_FORMULES('" & rs.Fields("formule").Value & "')"
        GetRecordset(ctDSN_AEM, szSQL, rs2)
        If rs2.RecordCount < 1 Then
            heure_conduite = ""
        Else
            heure_conduite = rs2.Fields("hconduit").Value
        End If

        ' lire le permis demandé pour controles
        szSQL = "CALL spGet_PERMIS('" & rs.Fields("permis_demande").Value & "')"
        GetRecordset(ctDSN_AEM, szSQL, rsPermis)
        If rsPermis.RecordCount < 1 Then
            MsgBox("Permis " & rs.Fields("permis_demande").Value & " non trouvée !", MsgBoxStyle.Critical)
            rsPermis.Close()
            rs.Close()
            Exit Function
        End If

        ' Lire l'examen en-cours
        szSQL = "CALL spGet_EXAMENS_byNO_EXA('" & Format(date_exa, "yyyy/MM/dd") & "'," & no_exa & "," & agence & ")"
        GetRecordset(ctDSN_AEM, szSQL, rsEXAM)
        If rsEXAM.RecordCount < 1 Then
            MsgBox("Examen du " & date_exa & " non trouvé !", MsgBoxStyle.Critical)
            rs.Close()
            Exit Function
        End If

        If rs.Fields("societe").Value <> rsEXAM.Fields("societe").Value Then
            MsgBox("Cet élève n'appartient pas à la même société !", MsgBoxStyle.Information)
        End If

        If IsDate(rs.Fields("dossier_valide").Value) And DateDiff(DateInterval.Day, rsEXAM.Fields("date").Value, rs.Fields("dossier_valide").Value) < 0 Then
            MsgBox("La VALIDITE du dossier de l'élève est DEPASEE. !", MsgBoxStyle.Critical)
            rsEXAM.Close()
            rs.Close()
            Exit Function
        End If

        ' =====  Controles des délais examen ETG  ===============
        If rsEXAM.Fields("permis").Value = "ETG" Then
            If IsAgeOK(rs.Fields("date_nais").Value, rsEXAM.Fields("date").Value, rsPermis.Fields("agecode").Value) = False Then
                MsgBox("L'élève n'a pas l'âge requis pour passer l'examen THEORIQUE !", MsgBoxStyle.Information)
            End If

            ' controler code valide ?
            If IsDate(rs.Fields("tr_t_ok").Value) Then
                If IsAgeOK(rs.Fields("tr_t_ok").Value, rsEXAM.Fields("date").Value, 3) = False Then
                    MsgBox("Cet élève a déjà obtenu son CODE. !", MsgBoxStyle.Information)
                End If
            End If

            szSQL = "Le DELAI pour la présentation au CODE n'est pas suffisant"
            Select Case rs.Fields("tr_t_nb").Value
                Case 0
                    If Controle_delai(date_exa, rs.Fields("dossier_date").Value, rsPermis.Fields("ucode1").Value, rsPermis.Fields("dcode1").Value) = False Then
                        MsgBox(szSQL, MsgBoxStyle.Information)
                    End If
                Case 1
                    If Controle_delai(date_exa, rs.Fields("tr_t_date").Value, rsPermis.Fields("ucode2").Value, rsPermis.Fields("dcode2").Value) = False Then
                        MsgBox(szSQL, MsgBoxStyle.Information)
                    End If
                Case 2
                    If Controle_delai(date_exa, rs.Fields("tr_t_date").Value, rsPermis.Fields("ucode3").Value, rsPermis.Fields("dcode3").Value) = False Then
                        MsgBox(szSQL, MsgBoxStyle.Information)
                    End If
                Case 3
                    If Controle_delai(date_exa, rs.Fields("tr_t_date").Value, rsPermis.Fields("ucode4").Value, rsPermis.Fields("dcode4").Value) = False Then
                        MsgBox(szSQL, MsgBoxStyle.Information)
                    End If
                Case 4
                    If Controle_delai(date_exa, rs.Fields("tr_t_date").Value, rsPermis.Fields("ucode5").Value, rsPermis.Fields("dcode5").Value) = False Then
                        MsgBox(szSQL, MsgBoxStyle.Information)
                    End If
            End Select

            rsEXAM.Close()
            rsPermis.Close()
            rs.Close()
            ControlesExamen = True
            Exit Function
        End If

        ' =====  Controles des délais examen PRATIQUE  ===============
        Dim permis_demande As String = rs.Fields("permis_demande").Value

        If permis_demande <> rsEXAM.Fields("permis").Value Then
            Dim PermisCompatible = False
            Select Case rsEXAM.Fields("permis").Value
                Case "GL"    ' examen groupe lourd
                    If permis_demande = "EC" Or permis_demande = "C" Or permis_demande = "D" Or permis_demande = "EB" Then
                        PermisCompatible = True
                    End If

                Case "2R"    ' examen 2 roues
                    If permis_demande = "A" Or permis_demande = "AL" Then
                        PermisCompatible = True
                    End If

            End Select
            If PermisCompatible = False Then
                MsgBox("La catégorie de permis demandée ne corespond pas à celle de l'examen !", MsgBoxStyle.Critical)
                rs.Close()
                rsEXAM.Close()
                rsPermis.Close()
                Exit Function
            End If
        End If

        If IsDate(rs.Fields("tr_t_ok").Value) = False Then
            If IsPermisValide(rsEXAM.Fields("date").Value) = False Then
                MsgBox("L'élève n'a pas encore onbtenu le CODE ou son CODE est périmé!", MsgBoxStyle.Information)
                Exit Function
            End If
        Else
            If IsAgeOK(rs.Fields("tr_t_ok").Value, rsEXAM.Fields("date").Value, rsPermis.Fields("vcode").Value) = True Then
                MsgBox("Le CODE de l'élève n'est plus valide !", MsgBoxStyle.Information)
                Exit Function
            End If
        End If
        If IsAgeOK(rs.Fields("date_nais").Value, rsEXAM.Fields("date").Value, rsPermis.Fields("agecode").Value) >= 0 Then
            MsgBox("L'élève n'a pas l'âge requis pour passer l'examen PRATIQUE !", MsgBoxStyle.Information)
        End If

        ' permis avec circulation 
        If rsPermis.Fields("droute1").Value Or rsPermis.Fields("droute2").Value Or rsPermis.Fields("droute3").Value Then
            If IsDate(rs.Fields("tr_p_ok").Value) And IsDate(rs.Fields("tr_r_ok").Value) Then
                MsgBox("Cet élève a déjà réussi l'examen de CONDUITE !", MsgBoxStyle.Information)
                Exit Function
            End If
        Else
            If IsDate(rs.Fields("tr_p_ok").Value) Then
                MsgBox("Cet élève a déjà réussi l'examen PRATIQUE !", MsgBoxStyle.Information)
                Exit Function
            End If
        End If

        ' controler le nombre d'heures de contuite
        If rsPermis.Fields("hcond").Value > 0 Then
            szSQL = "CALL spGet_ELEVES_CPT_byREF(" & cd_cli & ",'" & heure_conduite & "',1)"
            GetRecordset(ctDSN_AEM, szSQL, rs2)
            If rs2.RecordCount < rsPermis.Fields("hcond").Value Then
                MsgBox("Le nombre d'heures de conduite obligatoire n'est pas atteint", MsgBoxStyle.Information)
            End If
            rs2.Close()
        End If

        ' controler les délais examen PLATEAU
        If IsDate(rs.Fields("tr_p_ok").Value) = False Then
            szSQL = "Le DELAI pour la présentation à la PRATIQUE n'est pas suffisant"
            Select Case rs.Fields("tr_p_nb").Value
                Case 0
                    If Controle_delai(date_exa, rs.Fields("tr_t_ok").Value, rsPermis.Fields("ucond1").Value, rsPermis.Fields("dcond1").Value) = False Then
                        MsgBox(szSQL, MsgBoxStyle.Information)
                        Exit Function
                    End If
                Case 1
                    If Controle_delai(date_exa, rs.Fields("tr_p_date").Value, rsPermis.Fields("ucond2").Value, rsPermis.Fields("dcond2").Value) = False Then
                        MsgBox(szSQL, MsgBoxStyle.Information)
                        Exit Function
                    End If
                Case 2
                    If Controle_delai(date_exa, rs.Fields("tr_p_date").Value, rsPermis.Fields("ucond3").Value, rsPermis.Fields("dcond3").Value) = False Then
                        MsgBox(szSQL, MsgBoxStyle.Information)
                        Exit Function
                    End If
                Case 3
                    If Controle_delai(date_exa, rs.Fields("tr_p_date").Value, rsPermis.Fields("ucond4").Value, rsPermis.Fields("dcond4").Value) = False Then
                        MsgBox(szSQL, MsgBoxStyle.Information)
                        Exit Function
                    End If
                Case 4
                    If Controle_delai(date_exa, rs.Fields("tr_p_date").Value, rsPermis.Fields("ucond5").Value, rsPermis.Fields("dcond4").Value) = False Then
                        MsgBox(szSQL, MsgBoxStyle.Information)
                        Exit Function
                    End If
            End Select
        Else
            ' permis avec circulation ?
            If rsPermis.Fields("droute1").Value Or rsPermis.Fields("droute2").Value Or rsPermis.Fields("droute3").Value Then
                szSQL = "Le DELAI pour la présentation à la PRATIQUE n'est pas suffisant"
                Select Case rs.Fields("tr_r_nb").Value
                    Case 0
                        If Controle_delai(date_exa, rs.Fields("tr_p_ok").Value, rsPermis.Fields("uroute1").Value, rsPermis.Fields("droute1").Value) = False Then
                            MsgBox(szSQL, MsgBoxStyle.Information)
                            Exit Function
                        End If
                    Case 1
                        If Controle_delai(date_exa, rs.Fields("tr_r_date").Value, rsPermis.Fields("uroute2").Value, rsPermis.Fields("droute2").Value) = False Then
                            MsgBox(szSQL, MsgBoxStyle.Information)
                            Exit Function
                        End If
                    Case 2
                        If Controle_delai(date_exa, rs.Fields("tr_r_date").Value, rsPermis.Fields("uroute3").Value, rsPermis.Fields("droute3").Value) = False Then
                            MsgBox(szSQL, MsgBoxStyle.Information)
                            Exit Function
                        End If
                End Select

            End If
        End If

        rsEXAM.Close()
        rs.Close()
        ControlesExamen = True

    End Function

    Private Function Controle_delai(ByVal date_exa As Date, ByVal dateref As Object, ByVal unite As String, ByVal delai As Integer) As Boolean

        Controle_delai = False
        ' dateref = date valide ?
        If IsDate(dateref) = False Then
            Controle_delai = True
            Exit Function
        End If
        If unite = "Mois" Then
            unite = "m"
        Else
            unite = "d"
        End If
        If DateDiff(unite, dateref, date_exa) >= delai Then
            Controle_delai = True
        End If

    End Function

    Public Function getDateDerniere(ByVal type As String, ByVal nAgence As Integer) As DateTime

        ' lire l'agence 6 (le siège)
        szSQL = "CALL spGet_P_TABLES_byCODE('P_AGENCES'," & nAgence & ")"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount > 0 Then
            If type = "export" Then
                getDateDerniere = rs.Fields("dern_export").Value
            Else
                getDateDerniere = rs.Fields("dern_validation").Value
            End If
        Else
            getDateDerniere = Now()
        End If
        rs.Close()

    End Function

    Public Function IsHoliday(ByVal Jour As Date) As Boolean
        Dim var1, var2, var3, var4, var5, var6, var7 As Integer
        Dim annee As Integer
        Dim paques As Date

        IsHoliday = True

        ' dimanche ?
        If Weekday(Jour) = 1 Then
            Exit Function
        End If

        ' jours fériées fixes ?
        If (Jour.Day = 1 And Jour.Month = 1) Or (Jour.Day = 1 And Jour.Month = 5) Or _
              (Jour.Day = 8 And Jour.Month = 5) Or (Jour.Day = 14 And Jour.Month = 7) Or _
              (Jour.Day = 15 And Jour.Month = 8) Or (Jour.Day = 1 And Jour.Month = 11) Or _
              (Jour.Day = 11 And Jour.Month = 11) Or (Jour.Day = 25 And Jour.Month = 12) Then
            Exit Function
        End If
        ' détermination de Paques
        annee = Year(Jour)
        var1 = annee Mod 19 + 1
        var2 = (annee \ 100) + 1
        var3 = ((3 * var2) \ 4) - 12
        var4 = (((8 * var2) + 5) \ 25) - 5
        var5 = ((5 * annee) \ 4) - var3 - 10
        var6 = (11 * var1 + 20 + var4 - var3) Mod 30

        If (var6 = 25 And var1 > 11) Or (var6 = 24) Then
            var6 = var6 + 1
        End If

        var7 = 44 - var6
        If var7 < 21 Then
            var7 = var7 + 30
        End If
        var7 = var7 + 7
        var7 = var7 - (var5 + var7) Mod 7

        If var7 <= 31 Then
            paques = DateValue(CStr(var7) & "/3/" & CStr(annee))
        Else
            paques = DateValue(CStr(var7 - 31) & "/4/" & CStr(annee))
        End If
        If DateDiff(DateInterval.Day, paques, Jour) = 1 Then    ' = lundi de paques
            Exit Function
        End If
        If DateDiff(DateInterval.Day, paques, Jour) = 39 Then   ' = ascension
            Exit Function
        End If
        If DateDiff(DateInterval.Day, paques, Jour) = 50 Then   ' = pentecote
            Exit Function
        End If

        IsHoliday = False

    End Function

    Public Function getLundiPrecedent(ByVal Jour As Date) As Date

        ' On calcule le lundi précédent la date Jour
        getLundiPrecedent = Jour.AddDays(-(Weekday(Jour) - vbMonday))
        getLundiPrecedent = getLundiPrecedent.Date

    End Function

    Public Function UpdatePlanningB(ByVal ligStatut As Integer, ByVal ligNumero As Integer, ByVal ligIntitule As String) As Boolean

        ' calculer le montant debit de l'heure selon le nombre d'heures gratuites du forfait
        '
        Dim rsEleve As ADODB.Recordset = Nothing
        Dim rsFormule As ADODB.Recordset = Nothing
        Dim szIntitule As String = ""
        Dim mtDebit As Decimal
        Dim mtValeur As Decimal
        Dim mtTarif As Decimal = 0
        Dim nStatut As Integer
        Dim nHeuresGrat As Integer
        Dim dateFinContrat As Date

        UpdatePlanningB = False
        ' est-ce un élève ? non, ne rien faire
        If IsEleve(gCD_CLI) = False Then
            UpdatePlanningB = True
            Exit Function
        End If

        ' Lire la fiche Elève
        szSQL = "CALL spGet_ELEVES_byCD_CLI(" & gCD_CLI & ")"
        GetRecordset(ctDSN_AEM, szSQL, rsEleve)
        If rsEleve.RecordCount < 1 Then
            MsgBox("Elève " & gCD_CLI & " non trouvé !", MsgBoxStyle.Critical)
            rs.Close()
            Exit Function
        End If
        ' lire sa formule 
        szSQL = "CALL spGet_FORMULES('" & rsEleve.Fields("formule").Value & "')"
        GetRecordset(ctDSN_AEM, szSQL, rsFormule)
        If rsFormule.RecordCount < 1 Then
            MsgBox("Formule " & rsEleve.Fields("formule").Value & " non trouvée !", MsgBoxStyle.Critical)
            rsEleve.Close()
            Exit Function
        End If
        ' lire le tarif
        szSQL = "CALL spGet_TARIFS('" & rsFormule.Fields("hconduit").Value & "')"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount > 0 Then
            mtTarif = rs.Fields("puttc").Value     ' = montant tarif
            rs.Close()
        End If

        dateFinContrat = rsEleve.Fields("fin_contrat_le").Value
        nHeuresGrat = rsFormule.Fields("nbhcgratuit").Value

        ' Lire les heures B de l'élève
        szSQL = "CALL spGet_ELEVES_HEURES(" & gCD_CLI & ",'" & rsFormule.Fields("hconduit").Value & "')"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        Do While Not rs.EOF
            ' heure de conduite B
            If rs.Fields("noplan").Value Then
                ' si forfait expiré, raz les présentations gratuites
                If rsFormule.Fields("duree").Value And DateDiff(DateInterval.Day, rs.Fields("date").Value, dateFinContrat) < 0 Then
                    nHeuresGrat = 0
                End If

                If nHeuresGrat < 0 Then nHeuresGrat = 0
                ' ligne = ligne à valider
                If rs.Fields("no_ligne").Value = ligNumero Then
                    nStatut = ligStatut
                    szIntitule = Mid(ligIntitule, 1, 15) & " (" & nStatut & ")"
                Else
                    nStatut = rs.Fields("statut").Value
                    szIntitule = rs.Fields("intitule").Value
                End If
                ' Heure déja validée ?
                If IsDate(rs.Fields("date_valeur").Value) Then
                    ' oui, si heure à débiter, le décompter
                    If nStatut < 10 Then
                        nHeuresGrat = nHeuresGrat - rs.Fields("qte").Value
                    End If
                Else
                    ' non, calculer son debit
                    mtDebit = mtTarif
                    mtValeur = mtTarif

                    If nStatut < 10 Then   ' heure à débiter
                        If nHeuresGrat > 0 Then
                            mtDebit = 0
                            mtValeur = rsEleve.Fields("valeur_hc").Value
                            nHeuresGrat = nHeuresGrat - rs.Fields("qte").Value
                        End If
                    Else
                        mtDebit = 0    ' = non facturé
                        mtValeur = 0
                    End If
                    ' mettre à jpur la ligne
                    szSQL = "UPDATE eleves_cpt SET statut=" & nStatut & ", intitule='" & szIntitule & _
                            "', debit=" & mtDebit & ", mtval=" & mtValeur & " WHERE no_ligne=" & rs.Fields("no_ligne").Value
                    ExecQuery(ctDSN_AEM, szSQL)

                End If
            End If
            rs.MoveNext()
        Loop
        rsFormule.Close()
        rsEleve.Close()

        UpdatePlanningB = True

    End Function

    Public Function UpdateHeureMoto(ByVal pType As String, ByVal pDate As Date, ByVal pGroupe As String, ByVal pStatut As Integer, ByVal validation As String) As Boolean

        Dim rsEleve As ADODB.Recordset = Nothing
        Dim rsFormule As ADODB.Recordset = Nothing
        Dim szIntitule As String = ""
        Dim szRef As String = ""
        Dim mtDebit As Decimal
        Dim mtValeur As Decimal
        Dim nQte As Integer
        Dim mtTarif As Decimal
        Dim szTarif As String = ""
        Dim nHeuresRoute As Integer
        Dim nHeuresPlateau As Integer
        Dim nstatut As Integer
        Dim dateFinContrat As Date
        Dim szValide As String

        UpdateHeureMoto = False

        ' Lire la fiche Elève
        szSQL = "CALL spGet_ELEVES_byCD_CLI(" & gCD_CLI & ")"
        GetRecordset(ctDSN_AEM, szSQL, rsEleve)
        If rsEleve.RecordCount < 1 Then
            MsgBox("Elève " & gCD_CLI & " non trouvé! Sa séance ne sera pas validée.", MsgBoxStyle.Critical)
            Exit Function
        End If
        ' lire sa formule 
        szSQL = "CALL spGet_FORMULES('" & rsEleve.Fields("formule").Value & "')"
        GetRecordset(ctDSN_AEM, szSQL, rsFormule)
        If rsFormule.RecordCount < 1 Then
            MsgBox("Formule " & rsEleve.Fields("formule").Value & " non trouvée pour l'élève " & gCD_CLI, MsgBoxStyle.Critical)
            Exit Function
        End If

        mtDebit = 0
        mtValeur = 0
        dateFinContrat = rsEleve.Fields("fin_contrat_le").Value

        ' si forfait expiré, raz les heures gratuites
        If rsFormule.Fields("duree").Value And DateDiff(DateInterval.Day, pDate, dateFinContrat) < 0 Then
            nHeuresRoute = 0
            nHeuresPlateau = 0
        Else
            nHeuresRoute = rsFormule.Fields("nbhrgratuit").Value
            nHeuresPlateau = rsFormule.Fields("nbhcgratuit").Value
        End If

        ' préparation code
        If pType = "D" Then
            ' si formule = stage, 3 séances gratuites
            If rsFormule.Fields("stage").Value Then
                nHeuresPlateau = 3
            Else
                nHeuresPlateau = 0
            End If
        End If
        ' déterminer le tarif selon type de planning
        Select Case pType
            Case "A"   ' heures moto
                szRef = rsFormule.Fields("hconduit").Value
            Case "R"
                szRef = "RDVP"
            Case "D"
                szRef = "PREPACODE"
            Case "P"
                szRef = "PREPAPSY"
            Case "I"
                szRef = "CIRCUIT"
            Case "E"
                szRef = "TB"
        End Select
        ' lire le tarif
        szSQL = "CALL spGet_TARIFS('" & szRef & "')"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount > 0 Then
            mtTarif = rs.Fields("puttc").Value     ' = montant tarif
            szTarif = rs.Fields("lib").Value
            rs.Close()
        End If

        ' Lire les heures de l'élève
        szSQL = "CALL spGet_ELEVES_HEURES(" & gCD_CLI & ",'" & szRef & "')"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        Do While Not rs.EOF
            ' mémoriser la qté
            nQte = rs.Fields("qte").Value
            mtDebit = mtTarif      ' = montant tarif
            mtValeur = mtTarif
            szIntitule = szTarif
            ' raz nb d'heures gratuites si négatif
            If nHeuresRoute < 0 Then nHeuresRoute = 0
            If nHeuresPlateau < 0 Then nHeuresPlateau = 0
            ' ligne lue = ligne à valider
            szValide = ""
            If rs.Fields("date").Value = pDate And Format(rs.Fields("heure").Value, "hh:mm:ss") = Seconds2Time(Asc(pGroupe) * 100) Then
                nstatut = pStatut
                If validation = "V" Then
                    szValide = ", date_valeur=now(), statut=" & nstatut
                End If
            Else
                nstatut = rs.Fields("statut").Value
            End If
            ' determination du tarif à débiter selon le type d'heure
            Select Case pType
                Case "A"    ' heures moto
                    Dim bRoute As Boolean = rs.Fields("route").Value

                    ' Heure déja validée ?
                    If IsDate(rs.Fields("date_valeur").Value) Then
                        ' oui, si heure à débiter, le décompter
                        If nstatut < 10 Then
                            If bRoute = False Then
                                nHeuresPlateau -= rs.Fields("qte").Value
                            Else
                                nHeuresRoute -= rs.Fields("qte").Value
                            End If
                        End If
                    Else
                        If bRoute = False Then    ' heure plateau
                            szIntitule = Mid(szTarif, 1, 15) & " (" & nstatut & ")"
                        Else
                            szIntitule = Mid(szTarif, 1, 13) & " (" & nstatut & ") R"
                        End If
                        ' non, calculer son debit
                        If pStatut < 10 Then   ' heure à débiter
                            If bRoute = False Then    ' heure plateau
                                If nHeuresPlateau > 0 Then
                                    mtDebit = 0
                                    mtValeur = rsEleve.Fields("valeur_hc").Value
                                    szIntitule = "FORFAIT PLATEAU (" & pStatut & ")"
                                    nHeuresPlateau -= rs.Fields("qte").Value
                                End If
                            Else
                                If nHeuresRoute > 0 Then
                                    mtDebit = 0
                                    mtValeur = rsEleve.Fields("valeur_hc").Value
                                    szIntitule = "FORFAIT ROUTE (" & pStatut & ")"
                                    nHeuresRoute -= rs.Fields("qte").Value
                                End If
                            End If
                        Else
                            mtDebit = 0    ' = non facturé
                            mtValeur = 0
                            nQte = 0
                        End If
                    End If
                Case "R", "P", "E"
                    If pStatut > 10 Then   ' heure à ne pas débiter
                        mtDebit = 0    ' = non facturé
                        mtValeur = 0
                        nQte = 0
                    End If

                Case "I"    ' heures circuit
                    ' Heure déja validée ?
                    If IsDate(rs.Fields("date_valeur").Value) Then
                        ' oui, si heure à débiter, le décompter
                        If nstatut < 10 Then
                            ' heures gratuites ?
                            If nHeuresPlateau > 0 Then
                                nHeuresPlateau -= 1
                            End If
                        End If
                    Else
                        If pStatut < 10 Then   ' heure à débiter
                            If nHeuresPlateau > 0 Then
                                mtDebit = 0
                                mtValeur = rsEleve.Fields("valeur_cc").Value
                                szIntitule = "FORFAIT CIRCUIT (" & pStatut & ")"
                                nHeuresPlateau -= 1
                            End If
                        Else
                            mtDebit = 0    ' = non facturé
                            mtValeur = 0
                            nQte = 0
                        End If
                    End If

                Case "D"
                    ' Heure déja validée ?
                    If IsDate(rs.Fields("date_valeur").Value) Then
                        ' oui, si heure à débiter, le décompter
                        If nstatut < 10 Then
                            ' heures gratuites ?
                            If nHeuresPlateau > 0 Then
                                nHeuresPlateau -= 1
                            End If
                        End If
                    Else
                        If pStatut < 10 Then   ' heure à débiter
                            If nHeuresPlateau > 0 Then
                                mtDebit = 0
                                mtValeur = 0
                                szIntitule = "PREPA CODE GRATUIT (" & pStatut & ")"
                                nHeuresPlateau -= 1
                            End If
                        Else
                            mtDebit = 0    ' = non facturé
                            mtValeur = 0
                            nQte = 0
                        End If
                    End If

            End Select
            ' Heure déja validée ?
            If IsDate(rs.Fields("date_valeur").Value) = False Then
                ' mettre à jour
                szSQL = "UPDATE eleves_cpt SET statut=" & pStatut & ", intitule='" & szIntitule & "', qte=" & nQte & szValide & _
                        ", debit=" & mtDebit & ", mtval=" & mtValeur & " WHERE no_ligne=" & rs.Fields("no_ligne").Value
                ExecQuery(ctDSN_AEM, szSQL)
            End If
            rs.MoveNext()
        Loop

        rsFormule.Close()
        rsEleve.Close()

        UpdateHeureMoto = True

    End Function

    Private Function Seconds2Time(ByVal nSeconds As Integer) As String
        ' convertir un npmbre de secondes en time 'hh:mm:ss'
        Dim Mytimes As TimeSpan = New TimeSpan(0, 0, nSeconds)

        Seconds2Time = Mytimes.ToString

    End Function

    '---------------------------------------------------------------------
    ' This will clear the text in all text boxes on the passed control
    ' as well as any of its child controls. It is useful when having many
    ' TexBoxes on a form that are also in many different parent controls
    ' and you want to clear them all at once.
    '
    ' Example usage:
    '    ClearTextBoxes(Me)
    '---------------------------------------------------------------------
    Public Sub ClearTextBoxes(ByVal ctrl As Control)
        Dim c As Control

        For Each c In ctrl.Controls
            If c.HasChildren Then
                ClearTextBoxes(c)
            ElseIf TypeOf (c) Is TextBox Then
                c.Text = ""
            End If
        Next
    End Sub

    Private Function IsPermisValide(ByVal dateref As Date) As Boolean
        Dim rs As ADODB.Recordset = Nothing

        IsPermisValide = False

        ' Lire le dernier permis obtenu
        szSQL = "CALL spGet_ELEVES_PERMIS_byCD_CLI(" & gCD_CLI & ")"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount Then
            If IsDate(rs.Fields("perime_le").Value) = False Then
                Exit Function
            Else
                ' date de péremption du dernier permis dépassée ?
                If DateDiff(DateInterval.Day, rs.Fields("perime_le").Value, dateref) > 0 Then
                    Exit Function
                End If
            End If
        Else
            Exit Function
        End If
        IsPermisValide = True

    End Function

    Public Function IsEleve(ByVal cd_cli As Integer) As Boolean
        Dim rs As ADODB.Recordset = Nothing

        IsEleve = False

        ' Lire le numéro agence
        ' si = 0 => activités ou elèves provisoires
        szSQL = "CALL spGet_ELEVES_AGENCE(" & cd_cli & ")"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount Then
            If rs.Fields("agence").Value > 0 Then
                IsEleve = True
            End If
            rs.Close()
        End If

    End Function

    Public Sub SortListView(ByVal lvw As ListView, ByRef oldColumn As ColumnHeader, ByVal newColumnIndex As Integer)

        ' Get the new sorting column.
        Dim newColumn As ColumnHeader = lvw.Columns(newColumnIndex)
        ' Figure out the new sorting order.
        Dim sort_order As System.Windows.Forms.SortOrder
        If newColumn Is Nothing Then
            ' New column. Sort ascending.
            sort_order = SortOrder.Ascending
        Else ' See if this is the same column.
            If newColumn.Equals(oldColumn) Then
                ' Same column. Switch the sort order.
                If oldColumn.Text.StartsWith("> ") Then
                    sort_order = SortOrder.Descending
                Else
                    sort_order = SortOrder.Ascending
                End If
            Else
                ' New column. Sort ascending.
                sort_order = SortOrder.Ascending
            End If
            ' Remove the old sort indicator.
            If Not oldColumn Is Nothing Then
                oldColumn.Text = oldColumn.Text.Substring(2)
            End If

        End If
        ' Display the new sort order.
        oldColumn = newColumn
        If sort_order = SortOrder.Ascending Then
            oldColumn.Text = "> " & oldColumn.Text
        Else
            oldColumn.Text = "< " & oldColumn.Text
        End If
        ' Create a comparer and sort
        lvw.ListViewItemSorter = New clsListViewSorter(newColumnIndex, sort_order)
        lvw.Sort()

    End Sub

    Private Function IsAgeOK(ByVal dDate1 As Date, ByVal dDate2 As Date, ByVal dAge As Decimal) As Boolean
        ' Controler dDate1 par rapport dDate2 et dAge en tenant compte des décimales

        Dim dResultat As Date
        Dim nAnnee As Integer
        Dim nMois As Integer

        nAnnee = Int(dAge)
        nMois = (dAge - nAnnee) * 120 / 10
        dResultat = dDate1
        dResultat = dResultat.AddYears(nAnnee)
        dResultat = dResultat.AddMonths(nMois)
        If DateDiff(DateInterval.Day, dResultat, dDate2) >= 0 Then
            IsAgeOK = True
        Else
            IsAgeOK = False
        End If

    End Function

    Public Function LibelleStage(ByVal type As String) As String

        LibelleStage = "Planning Stage "
        Select Case type
            Case "B"
                LibelleStage = LibelleStage & "B"
            Case "M"
                LibelleStage = LibelleStage & "Moto"
            Case "C"
                LibelleStage = LibelleStage & "PàP"
        End Select

    End Function

    Public Function LibelleMoto(ByVal type As String) As String

        LibelleMoto = "Planning "
        Select Case type
            Case "A"
                LibelleMoto = LibelleMoto & "MOTO"
            Case "I"
                LibelleMoto = LibelleMoto & "CIRCUIT"
            Case "R"
                LibelleMoto = LibelleMoto & "RDV PEDAG"
            Case "D"
                LibelleMoto = LibelleMoto & "CODE"
            Case "E"
                LibelleMoto = LibelleMoto & "EXAMEN BLANC"
        End Select

    End Function

    Public Function setModifiedBy(ByVal cree_le As Date, modif_le As Date, user As String) As String
        setModifiedBy = "Créé le " & Format(cree_le, "dd/MM/yy HH:mm") & ",  modifié le " & Format(modif_le, "dd/MM/yy HH:mm") & "  par " & user
    End Function

    Public Function StageHasPending(ByVal gTypePlanning As String, ByVal pSemaine As Integer, ByVal pGroupe As String) As Boolean
        ' y a-t-il des élèves provisoires dans le stage ?
        szSQL = "CALL spGet_PLA_STAGE_PROVISOIRES('" & gTypePlanning & "'," & pSemaine & ",'" & pGroupe & "')"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount > 0 Then
            StageHasPending = True
        Else
            StageHasPending = False
        End If
        rs.Close()
    End Function

    Public Function PlanningHasPending(ByVal gTypePlanning As String, ByVal pDate As String, ByVal pGroupe As String) As Boolean
        ' y a-t-il des élèves provisoires dans le stage ?
        szSQL = "CALL spGet_PLA_MOTO_LIGNES('" & gTypePlanning & "','" & pDate & "','" & pGroupe & "',-1)"
        GetRecordset(ctDSN_AEM, szSQL, rs)
        If rs.RecordCount > 0 Then
            PlanningHasPending = True
        Else
            PlanningHasPending = False
        End If
        rs.Close()
    End Function

    Public Function IsEmailValid(ByVal email As String) As Boolean

        ' Dim emailExpr As New System.Text.RegularExpressions.Regex("^([\w]+)@([\w]+)\.([\w]+)$")
        Dim emailExpr As New System.Text.RegularExpressions.Regex("^[a-zA-Z0-9][+a-zA-Z0-9._-]*@[a-zA-Z0-9][a-zA-Z0-9._-]*[a-zA-Z0-9]*\.[a-zA-Z]{2,4}$")
        Return emailExpr.IsMatch(email)

    End Function

End Module

